home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
langwn23.zip
/
SAMPLE04.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-02-11
|
53KB
|
1,422 lines
' giving your user a set of scrollable lists, with files and
' sub-directories that can be selected, is a common GUI technique.
' SAMPLE04.BAS shows how to use LangWin to achieve this effect.
' a mode 4 (wallpaper) window is used as background.
' several unmovable windows (of the same
' color as background window) with no shadows,
' are created to provide several
' scrollable lists in "one" window.
' the directory and file access routines are used to create
' scrollable lists of files and sub-directories. by clicking
' on a sub-directory, you can change into it, and it's contents
' (files and directories) will then be displayed in the scrollable
' lists.
' this sample also shows how to use an error recovery routine
' in the main module to detect when a drive is not ready,
' and allow the user to retry or quit the operation.
' subroutine DoFiles (which also calls ChgPath and SortIt) is
' meant to be a stand-alone routine that you can copy and use
' in your own programs. it implements techniques to create
' a "menu" with drives, sub-directories, files, and the current directory.
' these can be scrolled, selected, and/or changed.
DECLARE FUNCTION ChgPath% (NewPath$) ' changes to new path
DECLARE SUB DoFiles () ' menu of files, dirs, drives
DECLARE SUB SortIt (s$()) ' bubble sort
DECLARE SUB Main () ' main window
DECLARE FUNCTION VidType% () ' gets type of monitor
DECLARE SUB ProcessFiles (Qual$, Text$()) ' sample routine to process files
' must compile with qb /ah /L langwin
'$DYNAMIC make all arrays dynamic
DEFINT A-Z
'$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin.
' NOTE: LANGWIN.BI contains all definitions found
' in QB.BI, so include for QB.BI is not needed.
CLEAR , , 5000 ' set stack at 5000 bytes
'---------------------------------------------------------------
' first see if EGA or VGA monitor
mm = VidType
IF mm <> 3 AND mm <> 4 THEN
BEEP
PRINT
PRINT "LangWin's GUI only supports EGA and VGA."
PRINT
END
END IF
'----------------------------------------------------------------
' SHARED VARIABLES
' - dlett$: MUST contain the letter of the drive that is being
' referenced by the GetCurDir$ function.
' if the drive is not ready, the error routine in the main module will
' get control and use dlett$ in its error message.
' - ignor: used a flag for the error routine. when a drive is selected but
' not ready, the error routine gets control and opens a window that
' contains a RETRY button and possinly an IGNORE button.
' if ignor=0 then IGNORE button is NOT displayed; else it is displayed.
' selecting RETRY will cause the instruction that generated the
' "not ready" error to be retried. selecting IGNORE will pass control
' to the instruction after the one generating the error condition.
' - Ldrives: number of logical drives on the system
' - OneFlop: flag set (TRUE) if system has one floppy, else FALSE
DIM SHARED dlett$, ignor, Ldrives, OneFlop
'-----------------------------------------------------------------
ON ERROR GOTO ErrorTrap ' enable error routine
'-----------------------------------------------------------------
' get attribute from current screen so it can be restored upon exit
OrigAttr = SCREEN(1, 1, 1)' save original attribute from row 1, col 1
'-------------------------------------------------------------------
' if WIDTH command is used, it must be placed before call to LangWinInit
' because code in LangWinInit extracts max rows/cols from screen and saves
' in global variables.
WIDTH 80, 25
'----------------------------------------------------------------------
' these variables MUST be defined BEFORE call to LangWinInit.
' keep these as low as possible to conserve memory at run time.
MaxWindows = 10 ' max simultaneous open windows
MaxButtons = 40 ' max number of objects (including text labels) active
MaxTextLines = 200 ' maximum number of text lines in any scrollable win
MaxTextWins = 4 ' max windows that can have scrollable text
' must be <= MaxWindows
LOCATE , , 0 ' start with hidden text cursor
SCREEN 0, , 0, 0 ' text mode
CALL LangWinInit ' initialize (if mouse exists, it will be displayed)
' if you get "subscript out of range" error while
' in this routine, be sure you called QB with /ah.
' then try reducing the value of MaxWindows.
' check the WIDTH command; reduce number of columns,
' and/or number of rows.
'---------------------------------------------------------------------
' get actual number of logical drives on the system
' get # drives from ChangeDrive (i.e., int 21h, function 0Eh).
' value will be max of 5 or # logical drives specified
' in LASTDRIVE parm in config.sys (i.e., LASTDRIVE=c will cause ChangeDrive
' to return 5, not 3, as # logical drives - that's a DOS quirk, not mine).
' LASTDRIVE=g will cause ChangeDrive to return a 7.
' drives specified in LASTDRIVE parm, however, might not be actual
' number of drives on system (LASTDRIVE=z doesn't mean you have 26 drives)
' so, after we get LASTDRIVES value, we must determine how many logical
' drives really exist (without attempting to read from them
' which could produce a drive not ready error) - that is, we need to know
' how many drives are actually configured on the system, not how many
' are ready at this moment.
dd$ = GetCurDrive$ ' current default drive
Ldrives = ChangeDrive(dd$) 'get LASTDRIVES value
' now see how many drives are actually there
' step through each drive (starting with #1) and try to
' change to it with ChangeDrive. if successful, continue with loop.
' if unsuccessful, then previous drive was last drive on the system.
FOR i = 1 TO Ldrives
dl$ = CHR$(ASC("A") - 1 + i) ' compute a drive letter
x = ChangeDrive(dl$) ' try to change to it
IF x < 0 THEN ' successful?
Ldrives = i - 1 ' can't change to drive i, change value of ldrives
EXIT FOR ' stop scan
END IF
NEXT
x = ChangeDrive(dd$) ' now change back to original drive
'--------------------------------------------------------------------
' on systems with only one physical floppy drive, it can be logically
' referenced as both A: and B: (dos handles this).
' however, if the A: drive is "active" and you try and access the B: drive,
' dos will display the following message:
' "Insert diskett for drive B: and press any key when ready"
' unfortunately, you cannot control the placement of this message and it will
' ruin an otherwise attractive display of windows.
' if the system has one floppy, and either A: or B: is selected by user,
' i assume that both drive letters refer to the same physical drive,
' and i first make the appropriate logical letter "active" before the
' drive is accessed. this should avoid the dos message.
' a not ready condition will be detected, and an error window opened,
' if the A: or B: drive (which has been made active) is not ready
' (i.e., does not have a floppy inserted and the door closed).
' the byte at &H504 is used to make either A: or B: active.
' if it is set to 0, then A: is active; if 1 then B: is active
' (assuming that there is only one floppy on the system).
' the word at &H410 contains info on system equipment.
' if bit 0 is set, then the system has floppies.
' in that case, bits 6 & 7 indicate the number of floppies minus 1
' (i.e., if bits 6 & 7 are 0, then system has 1 floppy drive).
' first, lets see if this system has only one floppy drive
OneFlop = FALSE ' default for flag
DEF SEG = 0 ' establish addressability to low memory
IF (PEEK(&H410) AND &H1) = 1 THEN ' test bit 0 to see if any floppies
' floppies exist, see how many
' set flag if only one
IF (PEEK(&H410) AND &HC0) = 0 THEN OneFlop = TRUE
END IF
DEF SEG ' restore addressability
' the OneFlop flag will be used later (when a disk is selected)
' to determine if there's only one drive on the system,
' if only one floppy drive and either A: or B: is selected, then the
' corresponding logical drive must first made "active" (via byte at &H504)
' BEFORE any I/O is attempted on that drive. this will avoid DOS detecting
' that activity was attempted on an "inactive" logical drive and displaying
' the dreaded "insert diskett" message right in the middle
' of an otherwise nice looking display.
' if your system has only one
' floppy, and you want to see the effect of this DOS
' message, just set OneFlop=FALSE below this comment,
' and select the B: drive.
'-----------------------------------------------------------------------
' display "wallpaper"
IF HaveMouse THEN CALL HideMouseCursor ' first hide mouse pointer
CLS
CALL SetColor(8, 15)
FOR i = 1 TO MaxRows
LOCATE i, 1
PRINT STRING$(80, 178); ' can try 176, 177, or 178
NEXT
IF HaveMouse THEN CALL ShowMouseCursor ' display the mouse pointer
'==============================================================
CALL Main
'=====================================================================
IF HaveMouse THEN HideMouseCursor ' we're done with the mouse
bbb = (OrigAttr AND &HF0) \ 16 ' mask & shift to get original background
fff = OrigAttr AND &HF ' mask to get original foreground
PALETTE ' restore original palette
CALL SetColor(fff, bbb) ' restore orig foreground/background
CLS
LOCATE , , 1 ' make text cursor visible
END
'=============================================================
' error routine - when drive not ready, will open win with message
' - if file to be deleted, will set flag and return error #
ErrorTrap:
SELECT CASE ERR ' determine which error occured
CASE 71 ' drive not ready
' dlett$ MUST be SHARED and contain the letter of the drive that
' is being referenced by the GetCurDir$ function.
' ignor MUST be SHARED and is used a flag.
' if ignor=0 then IGNORE button is NOT displayed; else it is displayed.
BEEP
' open modal window with no close button
nr = BlankWin(16, 1, 23, 31, 4, 15, 1, 15, 0, 2)
x = ShowWinText(2, 4, 15, "DRIVE " + UCASE$(dlett$) + ": NOT READY!")
r1 = MakePushButton(4, 4, 7, "RETRY", 15, 3, 1)
IF ignor <> 0 THEN q1 = MakePushButton(4, 19, 8, "IGNORE", 15, 3, 1)
' wait for a button press
DO
wn = WinEvent(action)' wait for an event
' since error window was modal, it's the only one
' that can return events. no need to test for window number
IF action = 3 THEN ' button press?
button = WinParms(CurWinPtr, 16)
x = CloseWindow
SELECT CASE button' which button?
CASE r1 ' retry
RESUME
CASE q1 ' ignore
RESUME NEXT
END SELECT
END IF
LOOP
CASE ELSE ' any other error
ON ERROR GOTO 0 ' display the error
END SELECT
END
REM $STATIC
FUNCTION ChgPath (NewPath$)
' change path function
' INPUT:
' NewPath$: path to change to (can contain drive and directory)
' OUTPUT:
' 0: change was successful
' -1: invalid drive letter
' -2: drive not ready - current
' -3: drive not ready - spec in NewPath$
' -4: invalid dir name or could not change to dir
dlett$ = GetCurDrive$ ' save drive letter (get current drive).
' GetCurDrive$ will not do i/o to disk,
' thus it will not detect drive not ready
' (returns upper case value)
' if 2nd char in input field is colon (:),
' then assume first is a drive letter.
' get it (cvt to UCASE) and save in dlett$.
IF MID$(NewPath$, 2, 1) = ":" THEN
orglett$ = (LEFT$(NewPath$, 1)) ' extract letter
dlett$ = UCASE$(orglett$) ' convert to UCASE
END IF
' at this point, dlett$ has current drive letter (if NewPath$ did not
' specify a drive), or it has the drive letter specified in NewPath$
x = ASC(dlett$) ' get ascii value of the letter
' see if drive "letter" was valid and within range of real drives
' (the global variable Ldrives is defined in main module)
IF x < ASC("A") OR x > ASC("A") - 1 + Ldrives THEN
' drive "letter" was NOT valid
' either it was not a letter, or not a real drive on system
' open modal window with error msg
BEEP
y = BlankWin(9, 1, 16, 37, 4, 15, 1, 15, 0, 2)
y = ShowWinText(2, 2, 15, "Invalid drive letter specified: " + orglett$)
y = MakePushButton(4, 7, 4, "OK", 15, 3, 1)
y = WinEvent(z) ' wait for any event
y = CloseWindow
ChgPath = -1 ' return code
EXIT FUNCTION ' bail out
END IF
' drive letter was valid
' if system has only one floppy, and either A: or B: was selected,
' make that logical drive active to avoid the dos "insert diskette"
' message when attempting to do I/O to an inactive logical floppy.
' (OneFlop global variable is defined in the main module).
IF OneFlop THEN ' only one floppy on system?
IF dlett$ = "A" THEN ' was A: selected ?
DEF SEG = 0
flopsav = PEEK(&H504) ' save original
POKE &H504, 0 ' set A: active
DEF SEG
ELSEIF dlett$ = "B" THEN ' else was b: selected ?
DEF SEG = 0
flopsav = PEEK(&H504) ' save original
POKE &H504, 1 ' set B: active
DEF SEG
END IF
END IF
' change to new dir
ignor = 1 ' flag to display IGNORE button if drive not ready
x = 1234 ' init x to a value never returned by ChangeDir
x = ChangeDir(NewPath$) ' change to specified directory
' ChangeDir() will cause i/o to defualt drive.
' not ready condition will be detected and processed by error
' routine in main module. if IGNORE selected, x will remain set
' to 1234.
ignor = 0 ' reset flag
' lets see if drive was not ready and user selected ignore
IF x = 1234 THEN
' drive is not ready
' if single floppy system & drive A/B was selected, reset active floppy
' back to original state
IF OneFlop AND (dlett$ = "A" OR dlett$ = "B") THEN
DEF SEG = 0
POKE &H504, flopsav ' restore orig value
DEF SEG
END IF
' see if it was the current drive or some other (in NewPath$) not ready
IF dlett$ = GetCurDrive$ THEN
' the current drive is not ready
ChgPath = -2 ' set return code
ELSE
' drive specified in NewPath$ was not ready (it was not current drive)
ChgPath = -3 ' set return code
END IF
EXIT FUNCTION ' bail out
' drive was ready (or made ready). see if ChangeDir was ok
ELSEIF x < 0 THEN
'could not change to dir specified
' open modal window with no close icon
BEEP
y = BlankWin(9, 1, 16, 37, 4, 15, 1, 15, 0, 2)
' display message with reason
IF x = -1 THEN
y = ShowWinText(2, 2, 15, "Invalid dir name specified")
ELSE
y = ShowWinText(2, 2, 15, "Could not change dir")
END IF
y = MakePushButton(4, 7, 4, "OK", 15, 3, 1)
y = WinEvent(z) ' wait for any event
y = CloseWindow
ChgPath = -4 ' set return code
EXIT FUNCTION ' bail out
ELSE
' change to new dir was ok,
' change default drive (we know its ok and ready)
x = ChangeDrive(dlett$)' change to new drive
IF x < 0 THEN END ' error not likely since prev ChangDir was ok
END IF ' end of code to test for error in ChangeDir
ChgPath = 0 ' successful return code
END FUNCTION
SUB DoFiles
' this subroutine can be copied and used in your own programs
' (don't forget that it calls ChgPath and SortIt).
' DoFiles creates a "menu" with
' drives, sub-directories, files, and the current path.
' these can be scrolled, selected and/or changed.
' it uses the following LangWin functions:
' GetCurDrive$ get the current drive's letter
' ChangeDrive change the current drive
' GetCurDir$ get the current dir's name
' ChangeDir change the current dir
' GetFileNames get names of files in current drive:dir
' just click on the dir or drive you want to change to.
' the files in that directory will be displayed.
' click on file name to select it. click on GO to see a list
' of all file names selected (in practice, your code would do something
' with this list; like move, copy, delete, etc).
'
' the code in this routine could easily be modified to display
' an input field where the user could enter a file spec.
' you could use this file spec in the calls
' to GetFileNames(2, "*.*", Text$()) instead of the "*.*" parameter.
' in that way, only selected files matching the file spec would be displayed.
' i'll leave this modification as an exercise to the reader.
' this subroutine actually opens 4 separate windows, one each for
' drives, sub-directories, files, and current path. all windows use
' the same color scheme, and are placed over a window with "wallpaper" mode
' to give the illusion that there's really only one "menu" with multiple
' sections (when actually, 4 separate windows are displayed and used).
' therefore, we need to allow the mouse to select any of these 4 windows,
' but NOT any other underlying windows (which would then be made active and
' overlay part of "menu"). we can't make the 4 windows in the "menu" modal;
' that would prevent selection of objects in all but the active window.
' so, PRIOR to calling this DoFiles, all other open windows must
' be manually set to mode 4 (wallpaper) and reset to their original mode upon
' return. by setting other windows to mode 4, clicks on these other windows
' will be ignored. the following shows sample code to do this. it assumes one
' window, whose number is saved in variable main1, is open (if multiple
' windows were open, this code could easily be modified to set the mode of
' all open windows to 4):
' ' this code would be placed in the main moudle prior to calling DoFiles
' ' get handle of window whose number is main1, save in main1han
' ' (assume it's open at this point, no need to test return code)
' x = IsWinOpen(main1, main1han)
' zz = WinParms(main1han, 19)' save current mode of main1 win
' WinParms(main1han, 19) = 4 ' set mode of main1 win to wallpaper
' CALL DoFiles
' WinParms(main1han, 19) = zz ' restore mode
'=================== INITIALIZATION ==========================
' get current disk letter and directory
DefaultDisk$ = GetCurDrive$ ' get current drive letter
dlett$ = DefaultDisk$ ' shared variable - used in error routine
ignor = 1 ' flag to display IGNORE button if not ready
DefaultDir$ = "NOT READY" ' default to specific string
DefaultDir$ = GetCurDir$("") ' get current dir (i/o to drive)
ignor = 0 ' reset flag
skip1 = FALSE ' flag to skip display of all windows but drives
IF DefaultDir$ = "NOT READY" THEN skip1 = TRUE ' set skip flag if not ready
'---- BUILD THE MENU WITH DRIVES, SUB-DIRS, FILES, AND PATH -------
'====================== WALLPAPER =============================
' first, place a "wallpaper" window on the screen.
' this window will have a shadow and be the foundation of the menu.
' other windows with same color will be placed over this wallpaper window
' to give the impression of one menu with multiple scrollable lists.
' these other windows will be shadowless and unmovable.
PALETTE 4, 57 ' temporarily set attrib 4 to 57 (9) to min visual impact
wal = BlankWin(1, 10, 24, 46, -4, 1, 2, 15, 0, 4)
x = ShowWinText(22, 10, 15, "Double Click Files")
x = ShowWinText(23, 8, 15, " Then Click GO Button ")
'====================== DISPLAY DRIVES ==================================
' array to hold drive names (Ldrives was determined in main module)
REDIM Text$(1 TO Ldrives)
' for each drive on the system,
' make an array with drive letters in the form [-x-]
FOR i = 1 TO Ldrives
Text$(i) = "[-" + CHR$(ASC("A") - 1 + i) + "-]"
NEXT
' open a window and display the drives
' i'll omit error checking since all parms are static
' i'll also assume that Ldrives < MaxTextLines (else all drive names will not
' be displayed in the scrollable list).
drv = OpenScrollWindow(16, 33, 22, 46, -9, 15, 1, 15, Text$(), 2, 3, 5, 11, 0, -1)
x = ShowTitle("DRIVES", 14, 9)
'======================== DISPLAY DIRECTORIES =========================
REDIM Text$(1 TO 1) ' clear the array
IF NOT skip1 THEN ' bypass if default drive not ready
GOSUB XtractSubDirs ' go get sorted list of sub-dirs
END IF ' end bypass if not ready
' open a window for the directories
' i'll omit error checking since all parms are static
dirs = OpenScrollWindow(7, 33, 15, 46, -9, 15, 1, 15, Text$(), 2, 3, 7, 11, 0, -1)
x = ShowTitle("DIRS", 14, 9)
'============================ DISPLAY FILES IN CURRENT DIR ===============
IF NOT skip1 THEN ' bypass if default drive not ready
REDIM Text$(1 TO 1) ' clear the array
GOSUB XtractFileNames ' go get file names
END IF ' end of bypass if default drive not ready
' open a window for the files
' i'll omit error checking since all parms are static
fil = OpenScrollWindow(7, 10, 22, 32, -9, 15, 1, 15, Text$(), 2, 3, 14, 19, 0, -1)
x = ShowTitle("SELECT FILES", 14, 9)
ERASE Text$ ' save string memory until needed
'============================ DISPLAY CURRENT PATH =======================
pa = BlankWin(1, 10, 6, 46, -9, 15, 1, 15, 0, -1)
a$ = DefaultDisk$ + ":" + DefaultDir$ ' build current path string
x = ShowTitle("PATH", 14, 9)
pathn = MakeInputField(1, 2, 33, a$, 15, 1)
cd = MakePushButton(3, 3, 9, "Chg Dir", 15, 4, 1)
ggo = MakePushButton(3, 14, 4, "GO", 15, 4, 1)
quit = MakePushButton(3, 20, 6, "EXIT", 15, 4, 1)
PALETTE 4, 4 ' reset attribute 4 (instructions at bottom of menu will
' now be shown over a red background)
'===================== main loop =======================
DO
wn = WinEvent(action) ' wait for an event
SELECT CASE wn ' which window caused the event?
CASE drv ' drives window caused the event
' save index of text line with focus.
' it is equivalent to logical drive number (A=1, B=2, etc)
dnum = WinParms(CurWinPtr, 15) ' get index of text line with focus
dlett$ = CHR$(ASC("A") - 1 + dnum) ' convert to a letter
' if system has only one floppy, and either A: or B: was selected,
' make that logical drive active to avoid the dos "insert diskette"
' message when attempting to do I/O to an inactive logical floppy.
' (OneFlop global variable is defined in the main module).
IF OneFlop THEN ' only one floppy on system?
IF dlett$ = "A" THEN ' was A: selected ?
DEF SEG = 0
flopsav = PEEK(&H504) ' save original
POKE &H504, 0 ' set A: active
DEF SEG
ELSEIF dlett$ = "B" THEN ' else was b: selected ?
DEF SEG = 0
flopsav = PEEK(&H504) ' save original
POKE &H504, 1 ' set B: active
DEF SEG
END IF
END IF
' now, let's make sure selected drive is ready.
' if not, i'll display an error window.
' if the drive is ready, then ChangeDrive will be used
' to make it current. however,
' before making the selected drive current with ChangeDrive,
' use GetCurDir$ to see if it's ready
' (by getting current dir on that drive).
' ChangeDrive will successfully change to a logical drive, even if
' it's not ready. so, we need something to actually attempt to read
' from the drive to see if it's ready. GetCurDir$ will do this and
' detect if it's ready or not. if not ready, DOS will trap the
' error and transfer to the error routine in the main module
' (as long as we've executed an ON ERROR GOTO xxx statement there).
' if drive is not ready, error routine
' will get control, open a window, and give the user two choices:
' RETRY or IGNORE. The RETRY will cause a RESUME to be executed.
' this returns control to the same statement that caused the error
' (GetCurDir$) and it will be executed again.
' the IGNORE will cause a RESUME NEXT to be executed. this
' returns control to the statement AFTER the GetCurDir$ command that
' caused the error.
' by initializing a$ to "not ready", we can tell
' if GetCurDir$ was executed and if it was successful.
' when GetCurDir$ is executed, it returns a value that will be
' placed into a$. Thus, if a$ changes from "not ready",
' then we know GetCurDir$ was executed.
' if drive was not ready, and
' user selected IGNORE, then the RESUME NEXT will cause
' the GetCirDir$ statement to be skipped, and a$ will
' still be set to "not ready".
' in this case, we won't attempt to change to the selected drive.
' if a$ is something other than "not ready", then
' i'll assume GetCurDir$ was successful (not necessarily a valid
' assumption, you should check for error codes that could
' be returned from GetCurDir$).
ignor = 1 ' set flag to display the ignore button in drive not ready win
a$ = "NOT READY" ' initialize a$
a$ = GetCurDir$(dlett$) ' if successful, a$ will be the dir
ignor = 0 ' reset flag
' if successfully able to get current dir on new drive,
' then a$ will no longer be set to "not ready". in this case,
' change to new drive, get dirs and files, and show them in windows
IF a$ <> "NOT READY" THEN
' drive is ready
x = ChangeDrive(dlett$)' change to new drive
IF x < 0 THEN END ' error not likely since prev GetCurDir was ok
GOSUB ShowNewStuff ' refresh dir, files, & path wins
ELSE
' drive is not ready
' if single floppy system & drive A/B, reset active floppy
IF OneFlop AND (dlett$ = "A" OR dlett$ = "B") THEN
DEF SEG = 0
POKE &H504, flopsav ' restore orig value
DEF SEG
END IF
END IF
CASE dirs ' dir window caused the event
' new dir was selected.
' must update the dir, files, and path windows
' get the name of dir selected (ie with focus)
' from the text array displayed in the dir window.
i = WinParms(CurWinPtr, 18) ' slot of text for this window
j = WinParms(CurWinPtr, 15) ' entry with focus
a$ = SaveText(i, j) ' line of text with focus (ie dir name)
' bypass if dir name was dot (.); we're already there
' bypass if special names: <NONE> or (Incomplete List)
IF a$ <> "." AND a$ <> "<NONE>" AND a$ <> "(Incomplete List)" THEN
dlett$ = GetCurDrive$ ' in case not ready will have drive letter
x = 1234 ' set to value never returned by ChangeDir
ignor = 1 ' flag to display ignore button if disk not ready
x = ChangeDir(a$) ' make that dir current
' ChangeDir() will cause i/o to defualt drive.
' not ready condition will be detected and processed by error
' routine in main module. if IGNORE selected, x will remain set
' to 1234.
ignor = 0 ' reset flag
' bypass if drive was not ready and ignore button selected
IF x <> 1234 THEN ' if x is 1234, drive was not ready
IF x < 0 THEN END ' errors not likely since choice was from list
GOSUB ShowNewStuff ' call sub to refresh dir, files, and path wins
END IF
END IF
CASE fil ' files window caused the event
' lets get the name of file selected (ie with focus)
' from the text array displayed in the files window.
i = WinParms(CurWinPtr, 18) ' slot of text for this window
j = WinParms(CurWinPtr, 15) ' entry with focus
a$ = SaveText(i, j) ' line of text with focus
' bypass if special names:
' <NONE> or (Incomplete List)
IF a$ <> "<NONE>" AND a$ <> "(Incomplete List)" THEN
'toggle selection character
IF MID$(a$, 2, 1) = "X" THEN
MID$(a$, 2, 1) = " " ' un-select
ELSE
MID$(a$, 2, 1) = "X" ' select
END IF
SaveText(i, j) = a$
CALL ReShowText ' re-display text in win
END IF
CASE pa ' pathname window
' only action is the change path button
IF action = 3 THEN
SELECT CASE WinParms(CurWinPtr, 16) ' select button
CASE ggo ' go process selected files
' first make sure that contents of input field on screen
' is indeed the current dir.
' if not, user probably made a change to the input field,
' and hit the GO button instead of the Chg Dir button
' get current drive and dir
dlett$ = GetCurDrive$ ' get current drive
ignor = 1 ' ignore button displayed if not ready
cdir$ = "NOT READY" ' set a default value
cdir$ = GetCurDir$("") ' get current dir
ignor = 0 ' reset flag to display IGNORE button
skip1 = FALSE ' initialize flag used to skip processing
' when current drive is not ready and
' IGNORE clicked
' if cdir$ remains set to "NOT READY", then current drive
' was not ready and user selected IGNORE.
' in this case, set flag so further processing will be skipped
IF cdir$ = "NOT READY" THEN skip1 = TRUE
Fqual$ = dlett$ + ":" + cdir$ ' build full qualifier
' we now have current drive and dir, compare to input field
' (bypass this test if drive was not ready and ignore selected)
IF Fqual$ <> ButtonsText(pathn) AND NOT skip1 THEN
' current path <> input field on screen
BEEP
y = BlankWin(6, 1, 17, 57, 4, 15, 1, 15, 0, 2)
' display message with reason
y = ShowWinText(2, 2, 15, "Ambiguous path name detected - files NOT processed.")
y = ShowWinText(3, 2, 15, "Above path does not match current drive & dir:")
y = ShowWinText(4, 2, 14, Fqual$)
y = ShowWinText(6, 2, 15, "If necessary, use the Chg Dir button to change paths.")
y = ShowWinText(7, 2, 15, "Then use the GO button to process selected files.")
y = MakePushButton(9, 7, 4, "OK", 15, 3, 1)
y = WinEvent(z) ' wait for any event
y = CloseWindow
skip1 = TRUE ' set bypass flag
END IF
' ----- process all files selected -------------
' processing will be bypassed if current drive was not ready
' and user clicked IGNORE (in this case, skip1 will be TRUE).
IF NOT skip1 THEN
' add trailing \ to fully qualified path if not root
IF cdir$ <> "\" THEN Fqual$ = Fqual$ + "\"
' build an array with file names that were selected
REDIM Text$(1 TO MaxTextLines)
x = IsWinOpen(fil, fhan) ' we know win # (fil), get handle (fhan)
slot = WinParms(fhan, 18) ' slot of text for this window
' scan text array, move all files marked with [X] to Text$
txtptr = 0 ' slot in Text$ to get entry
FOR j = 1 TO WinParms(fhan, 17) ' scan text array
' find selected entries (will have [X] as 1st 3 characters)
IF LEFT$(SaveText(slot, j), 3) = "[X]" THEN
' current entry in SaveText was selected
lfil = LEN(SaveText(slot, j)) - 4 ' len of file name
txtptr = txtptr + 1 ' bump pointer to next Text$ slot
' this condition should never occur - safety net
IF txtptr > MaxTextLines THEN END
' move file name (without the [X]) to Text$ array
Text$(txtptr) = RIGHT$(SaveText(slot, j), lfil)
END IF
NEXT
' if no items selected in Text$, display error message
IF txtptr = 0 THEN
BEEP
y = BlankWin(17, 1, 24, 37, 4, 15, 1, 15, 0, 2)
y = ShowWinText(2, 2, 15, "No files were selected.")
y = MakePushButton(5, 7, 4, "OK", 15, 3, 1)
y = WinEvent(z) ' wait for any event
y = CloseWindow
ELSE
' Text$ array has been built, go process its contents
CALL ProcessFiles(Fqual$, Text$()) ' process selected files
' now redisplay contents of files window.
' we could just change the [X] to [ ] and
' redisplay the original list of file names.
' however, the processing performed in ProcessFIles
' could have changed the contents of the current directory
' (for example, the selected files could have been deleted).
' therefore, the current contents of the current directory
' are first determined (using GetFileNames), then displayed.
REDIM Text$(1 TO 1) ' clear the array
GOSUB XtractFileNames ' go get current file names
CALL NewFocusWindow(fhan) ' give focus to files window
CALL RefreshScrollText(Text$()) ' redisplay new file list
END IF
ERASE Text$ ' clear array to save string memory
END IF ' end of test to bypass
CASE quit ' quit
GOSUB CloseAll ' go close all open windows
EXIT DO ' bail out
CASE cd ' change dir
rr = ChgPath(ButtonsText(pathn)) ' go change path
SELECT CASE rr ' test return code
CASE -2 ' current drive is not ready
cdir$ = "NOT READY" ' current drive is not ready
skip1 = TRUE ' to skip display of dirs & files
GOSUB ShowNewStuff1 ' go update path window
CASE ELSE
GOSUB ShowNewStuff ' go update all windows
END SELECT ' end of select for change path
END SELECT ' end of select button in path win
END IF ' end of code to process action in path name window
END SELECT
LOOP ' continue until main window is closed
EXIT SUB
'=======================================================
' sub to re-display current sub-dirs, files, and path.
' called when change made in directory, drive, or path window
' (after appropriate drive and/or dir has been made current).
ShowNewStuff:
dlett$ = GetCurDrive$ ' just in case not ready condition
ignor = 1 ' ignore option displayed
cdir$ = "NOT READY"
cdir$ = GetCurDir$("")
ignor = 0 ' reset flag
skip1 = FALSE ' flag to skip display of dirs & files windows
IF cdir$ = "NOT READY" THEN skip1 = TRUE ' set skip flag if drive not ready
' second entry point - called if drive specified in input field was current
' and it was not ready. no need to check current drive's
' readiness again.
ShowNewStuff1:
' ========== DIRS ==================
' get new list of sub-dirs in current dir and redisplay then
REDIM Text$(1 TO 1) ' clear the array
IF NOT skip1 THEN ' bypass if default drive not ready
GOSUB XtractSubDirs ' go get sorted list of sub-dirs
END IF ' end of bypass in default drive not ready
x = IsWinOpen(dirs, wh) ' get handle of dirs window
CALL NewFocusWindow(wh) ' make it current
CALL RefreshScrollText(Text$()) ' redisplay new dir list
' ============== FILES ==============
IF NOT skip1 THEN ' bypass if default drive not ready
REDIM Text$(1 TO 1) ' clear the array
GOSUB XtractFileNames ' get file names
END IF ' end of bypass if defualt drive not ready
x = IsWinOpen(fil, wh) ' get handle of files window
CALL NewFocusWindow(wh) ' make it current
CALL RefreshScrollText(Text$()) ' redisplay new file list
ERASE Text$ ' save string memory
' =========== PATH ==============
' if selected path refs a drive that's not ready,
' and user selects IGNORE, then we must reset path input field to current
' path (otherwise, it will contain the not ready drive
' which could confuse the user since file and dir windows still have
' data from current path).
' make the path window current
x = IsWinOpen(pa, wh) ' get handle of window
CALL NewFocusWindow(wh) ' make it current
a$ = dlett$ + ":" + cdir$ ' build path string
ButtonsText(pathn) = a$ ' set to new path
ReShowInputField (pathn)' redisplay input field
RETURN
'=========================================================
' close all open files
CloseAll:
' reset palette for wallpaper window so it looks blue
' during closure of other windows
PALETTE 4, 57 ' change color of wallpaper win to blue
' while over-laying windows are closed
' (to minimize visual impact). will be changed back later
' close the windows with numbers: pa, fil, dirs, drv, wal
IF IsWinOpen(pa, Han) THEN ' get handle
CALL NewFocusWindow(Han) ' if open, make win active
x = CloseWindow ' close it
END IF
IF IsWinOpen(fil, Han) THEN ' get handle
CALL NewFocusWindow(Han) ' if open, make win active
x = CloseWindow ' close it
END IF
IF IsWinOpen(dirs, Han) THEN ' get handle
CALL NewFocusWindow(Han) ' if open, make win active
x = CloseWindow ' close it
END IF
IF IsWinOpen(drv, Han) THEN ' get handle
CALL NewFocusWindow(Han) ' if open, make win active
x = CloseWindow ' close it
END IF
IF IsWinOpen(wal, Han) THEN ' get handle
CALL NewFocusWindow(Han) ' if open, make win active
x = CloseWindow ' close it
END IF
' reset palette back to red
PALETTE 4, 4
RETURN
'===================================================================
' get sub-dirs, place into Text$, and sort
XtractSubDirs:
' get any sub-directories in current directory
x = GetFileNames(1, "*.*", Text$())
zer = OutRegs.ax ' save in case an unknown error occured
' test for errors
IF x < 0 THEN
SELECT CASE x
CASE -2 ' no matches
Text$(1) = "<NONE>"
CASE ELSE
' except for the case where there are no dirs (-2 case),
' i'll leave error checking to you.
' other errors are straight forward. once your code is debugged,
' they should not occur.
BEEP
z = BlankWin(14, 6, 21, 52, 5, 15, 1, 15, 0, 2)
z = ShowWinText(2, 4, 15, "Unknown error reading sub-dirs: " + STR$(zer))
z = MakePushButton(4, 14, 4, "OK", 15, 3, 1)
z = WinEvent(w) ' wait for any action
z = CloseWindow
GOSUB CloseAll ' close all open windows
EXIT SUB ' bail out
END SELECT
END IF
CALL SortIt(Text$()) ' sort the dirs
RETURN
'=================================================================
' get file names, prefix with [ ], place into Text$, sort
XtractFileNames:
' get files in current directory
x = GetFileNames(2, "*.*", Text$())
zer = OutRegs.ax ' save in case an unknown error occured
' insert [ ] in front of file names
FOR i = LBOUND(Text$) TO UBOUND(Text$)
IF LEN(Text$(i)) > 0 THEN Text$(i) = "[ ] " + Text$(i)
NEXT
' test for errors
IF x < 0 THEN
SELECT CASE x
CASE -2 ' no matches
Text$(1) = "<NONE>"
CASE ELSE
' except for the case where there are no files (-2 case),
' i'll leave error checking to you.
' other errors are straight forward. once your code is debugged,
' they should not occur.
BEEP
z = BlankWin(14, 6, 21, 52, 5, 15, 1, 15, 0, 2)
z = ShowWinText(2, 4, 15, "Unknown error reading files: " + STR$(zer))
z = MakePushButton(4, 14, 4, "OK", 15, 3, 1)
z = WinEvent(w) ' wait for any action
z = CloseWindow
GOSUB CloseAll ' close all open windows
EXIT SUB ' bail out
END SELECT
END IF
CALL SortIt(Text$()) ' sort the files
RETURN
END SUB
SUB Main
' this subroutine will open a window, display a GO button and the current
' directory's name. clicking the GO button will give control to the
' DoFiles subroutine which will open several windows:
' directory, drive, and files.
' while these windows are visible, you will be able to change the current
' directory or drive (and the corresponding files will be displayed).
' note the technique used to determine if the default drive is not ready.
' the variable used to save the current directory's name (DefaultDir$) is set
' to a default value. a flag (ignor) is set so the IGNORE button will be
' displayed in an error window if a "not ready" condition occurs.
' the GetCurDir$ function is called to get the current directory's name.
' this causes i/o to the default drive (note that GetCurDrive$ will NOT
' cause i/o to the current drive, DOS maintains the current drive's
' designation internally so i/o is not necessary).
' if the drive is not ready, the error routine (defined in the main module)
' will get control. the error routine tests for a not ready condition and
' if that condition caused the error, a window is opened. the window
' will have a RETRY button, and if the ignor flag is 1, it will also
' have an IGNORE button.
' if RETRY is selected, control is returned to the GetCurDir$ function
' (the current directory's name is returned and saved in
' the variable DefaultDir$). if the IGNORE button is clicked, then control
' is returned to the instruction after the call to GetCurDir$, and the
' the DefaultDir$ variable will retain it's original value.
' thus, by comparing the DefaultDir$ variable to its default setting,
' you can determine if the drive was not ready and IGNORE selected.
DefaultDisk$ = GetCurDrive$ ' get current drive's letter
dlett$ = DefaultDisk$ ' dlett$ variable is used by error routine
DefaultDir$ = "NOT READY" ' set default
ignor = 1 ' set flag: IGNORE button will be visible
DefaultDir$ = GetCurDir$("") ' error window will be open if drive not ready
ignor = 0 ' reset flag: IGNORE button not displayed
' if current drive was not ready, and IGNORE button clicked,
' then the DefaultDir$ variable will still contain the
' default string "NOT READY". compare to see if not ready error occured.
' in that case (default drive not ready), display window and exit.
IF DefaultDir$ = "NOT READY" THEN
BEEP
bail1 = BlankWin(3, 1, 10, 43, 9, 15, 1, 15, 0, 2)
x = ShowWinText(2, 2, 15, "Default drive could not be made ready")
x = ShowWinText(3, 2, 15, "Program terminating ...")
ok1 = MakePushButton(5, 7, 6, "BYE!", 15, 4, 1)
wn = WinEvent(action)' wait
x = CloseWindow ' any action - close
EXIT SUB
END IF
' main window
tr = 1 'top row
tc = 3 'top col
br = 9 'bottom row
bc = 60 'bottom col
' open a window to contain the current directory's name and a GO button
main1 = BlankWin(tr, tc, br, bc, 3, 15, 2, 15, 0, 1)
x = MakeHorizLine(4, 2) ' horizontal line
x = ShowWinText(5, 2, 15, "Current directory:") ' label for dir's name
' the current directory's name could now be displayed using a
' call to ShowWinText. however, the current dir name can be changed
' dynamically (via the DoFiles subroutine that is called by clicking
' the GO button). thus, upon return from DoFiles, we need a technique
' for changing the text that shows the current directory's name.
' this could be done by calling ShowWinText to display the current dir's
' name "over" the text with the old dir name. however,
' each call to ShowWinText uses a unique handle to access LangWin's data
' structures (the global MaxButtons defines the maximum number of handles).
' since the new dir name is displayed "over" the old name, there's really
' no reason for using up a new handle for the new dir name. we need a way to
' "reuse" the same handle to save the dir name's text and then display it.
' to accomplish this (ie, to reuse the existing handle), we must first
' determine what the handle number is. ShowWinText does NOT return a handle
' value, so we must figure out what the handle number is before we can
' reuse it. this can be done by first using ShowWinText to create text with a
' known value. then, by scanning LangWin's data structure
' (ie the ButtonsText() array) for that known value, the handle
' number can be determined. thereafter, the ReShowInputField(handle)
' can be used to redisplay the text (after changing its value
' in ButtonsText(handle) to the new dir's name).
x = ShowWinText(6, 2, 14, "KNOWN VALUE") ' define specific text
' now scan all button text to find handle of above text
cdnam = -999 ' default handle number
FOR i = 1 TO MaxButtons ' scan the entire data structure
IF ButtonsText(i) = "KNOWN VALUE" THEN ' look for specific text
cdnam = i ' if match, save handle
EXIT FOR ' terminate search
END IF
NEXT
' see if we have a serious problem, could not find specific text
IF cdnam = -999 THEN
CLS
BEEP
PRINT "INTERNAL ERROR"
PRINT "COULD NOT FIND HANDLE FOR SPECIFIC TEXT"
END
END IF
' at this point, cdnam contains handle where current dir name is saved
a$ = DefaultDisk$ + ":" + DefaultDir$ ' fully qualified dir name
ButtonsText(cdnam) = a$ ' update value in data structure
CALL ReShowInputField(cdnam) ' redisplay the dir name
ButtonsData(cdnam, 4) = LEN(a$) ' update length of area
ggo = MakePushButton(2, 2, 4, "GO", 15, 5, 1)
quit = MakePushButton(2, 30, 6, "QUIT", 15, 5, 1)
x = ShowTitle(" SAMPLE04 ", 3, 15)' place this last so title will be
' preserved if window is resized
'========== MAIN LOOP ========================================
DO WHILE AnyWinOpen
wn = WinEvent(action) ' wait for an event
SELECT CASE wn ' which window caused the event?
CASE main1
' only buttons exist
IF action = 3 THEN
' process the button
SELECT CASE WinParms(CurWinPtr, 16) ' select button handle
CASE ggo
' first, change mode of main win to wallpaper
' this will prevent selection of this win while the
' multiple windows opened in DoFiles are visible
' get handle of window whose number is main1, save in main1han
' (it's open at this point, no need to test return code)
x = IsWinOpen(main1, main1han)
zz = WinParms(main1han, 19)' save mode of main win
WinParms(main1han, 19) = 4 ' set mode of main win to wallpaper
CALL DoFiles
WinParms(main1han, 19) = zz ' restore original mode
' now redisplay the current dir name (which could have
' been changed while in DoFiles) using the original handle
' (saved in cdnam).
' get current disk letter and directory
dlett$ = GetCurDrive$ ' variable used by error routine
ignor = 0 ' set flag to hide IGNORE button.
' (ignoring a not ready condition on the
' default drive upon returning from
' DoFiles will not be an option).
cdir$ = GetCurDir$("") ' get current dir name
cd$ = dlett$ + ":" + cdir$ ' build fully qualified dir name
ButtonsText(cdnam) = cd$ ' update data structure
ReShowInputField (cdnam) ' redisplay current dir name
ButtonsData(cdnam, 4) = LEN(cd$) 'update length
CASE quit
' open modal window with no close icon
clos = BlankWin(1, 1, 7, 31, 4, 15, 1, 15, 0, 2)
x = ShowWinText(2, 2, 15, "Do you really want to quit?")
quity1 = MakePushButton(4, 7, 5, "YES", 15, 3, 1)
quitn1 = MakePushButton(4, 19, 4, "NO", 15, 3, 1)
' make "no" the default button
WinParms(CurWinPtr, 16) = quitn1 ' put handle in data structure
CALL ChangeButtonFocus(quitn1, 0) ' redisplay button with reverse video
END SELECT
END IF ' end of code for main1 window
CASE clos ' modal win asking if user really wants to quit
' only action that could occur is button press
IF action = 3 THEN 'but just in case, lets check the action
SELECT CASE WinParms(CurWinPtr, 16) ' handle of button clicked
CASE quity1 ' yes button
' following code is not technically necessary,
' you could just EXIT DO here, and return
' to the calling program (if you know that
' all the calling program will do is exit).
' however, if calling program will do other tasks,
' we must close all open windows before leaving, so ...
xx = CloseWindow' close the current win
' now close all other windows
' scan WinStack backwards, get win handle,
' make it active, then close it
FOR i = LastWinStack TO 1 STEP -1
CALL NewFocusWindow(WinStack(i)) ' make win active
x = CloseWindow ' close it
NEXT
EXIT DO ' bail out
CASE quitn1 ' no button in close warning window
' user changed their mind, just close the current window
xx = CloseWindow
END SELECT
END IF ' end of code for clos window
END SELECT ' end of code to process window numbers
LOOP
' now restore original drive & dir
' first restore dir.
' then if it's not ready and ignore button clicked,
' we can skip restoring the drive.
dlett$ = DefaultDisk$ ' needed by error routine
ignor = 1 ' flag to display IGNORE button
x = 1234 ' set default as a return code never used by ChangeDir
' ChangeDir() will cause i/o to defualt drive.
' not ready condition will be detected and processed by error routine
' in main module. if IGNORE selected, x will remain set to 1234.
x = ChangeDir(DefaultDisk$ + ":" + DefaultDir$) ' fully qualified
IF x <> 1234 THEN ' if x is still 1234, a not ready condition occured
' not ready condition did not occur
' so restore original drive
IF x < 0 THEN END 'error not likely since Default Dir exists
x = ChangeDrive(DefaultDisk$)
IF x < 0 THEN END ' drive error not likely since above change dir
' was successful
END IF
EXIT SUB ' bail out
END SUB
SUB ProcessFiles (Qual$, Text$())
' this is where you would place the code to process
' all selected files.
' Qual$ - contains the fully qualified path (drive & dir) for the files
' Text$() - contains the files selected
' in this sample, i'll just open a window and display the
' fully qualified names of all selected files
' add fully qualified path to file name
FOR i = LBOUND(Text$) TO UBOUND(Text$)
' only modify non-null entries
IF LEN(Text$(i)) > 0 THEN Text$(i) = Qual$ + Text$(i)
NEXT
' open window to scroll file names
hr1 = 1 ' start row
hc1 = 1 ' start col
hr2 = 18 ' end row
hc2 = 56 ' end col
hh = OpenScrollWindow(hr1, hc1, hr2, hc2, 2, 15, 2, 15, Text$(), 2, 2, hr2 - hr1 - 2 - 2, hc2 - hc1 - 2, 0, 2)
x = MakeHorizLine(hr2 - hr1 - 3, 2)
x = MakePushButton(hr2 - hr1 - 2, (hc2 - hc1) \ 2 - 2, 4, "OK", 15, 4, 1)
x = ShowTitle(" SELECTED FILES ", 2, 15)
DO
x = WinEvent(aa) ' wait for any event
LOOP WHILE aa = 2 ' loop if event was double click on text (aa=2)
' exit loop if event was ESC key (aa=1) or OK button (aa=3)
x = CloseWindow ' close
END SUB
SUB SortIt (s$())
' simple bubble sort - sort contents of s$ in ascending order
strt = LBOUND(s$)' starting index
en = UBOUND(s$)' ending index
' first scan backwards til first non-null entry.
' no need to sort them.
en1 = strt ' default value in case all entries are null
FOR i = en TO strt STEP -1
IF s$(i) <> "" THEN ' look for null
en1 = i ' save new ending index
EXIT FOR ' stop scan
END IF
NEXT
' if either 1 or no non-null entries, no need to sort
IF en1 = strt THEN EXIT SUB
' do the sort
FOR i = strt TO en1 - 1
FOR j = i + 1 TO en1
IF s$(j) < s$(i) THEN SWAP s$(j), s$(i)
NEXT
NEXT
END SUB
' =====================================================
' returns type of video display
'
' return values:
' 1: black/white (could be EGA/VGA with monochrome)
' 2: CGA (with color)
' 3: EGA (with color)
' 4: VGA (with color)
' 5: MCGA (with color)
' 99: other
'
FUNCTION VidType
' quick & dirty, check &h463
DEF SEG = 0
IF PEEK(&H463) = &HB4 THEN ' see if monochrome
VidType = 1
EXIT FUNCTION
END IF
DEF SEG
' first try int 10h, function 1Ah
InRegs.ax = &H1A00
CALL INTERRUPTX(&H10, InRegs, OutRegs)
IF (OutRegs.ax AND &HFF) = &H1A THEN ' see if int 10h, funct 1Ah supported
code = (OutRegs.bx AND &HFF) ' get display code
SELECT CASE code
CASE 1 ' MDA
VidType = 1
CASE 2 ' CGA
VidType = 2
CASE 4 ' EGA color
VidType = 3
CASE 5 ' EGA b/w
VidType = 1
CASE 7 ' VGA b/w
VidType = 1
CASE 8 ' VGA color
VidType = 4
CASE 10 ' MCGA color
VidType = 5
CASE 11 ' MCGA b/w
VidType = 1
CASE ELSE
VidType = 99 ' other
END SELECT
EXIT FUNCTION
ELSE
' now try int 10h, function 12h, sub-function 10h
InRegs.ax = &H1200
InRegs.bx = &H10
CALL INTERRUPTX(&H10, InRegs, OutRegs)
IF (OutRegs.bx AND &HFF00) = 1 THEN ' see if monochrome
VidType = 1
EXIT FUNCTION
END IF
IF (OutRegs.bx AND &HFF) <> &H10 THEN ' see if BL reg changed
VidType = 3 ' EGA (not sure why it couldn't be VGA too!)
EXIT FUNCTION
END IF
VidType = 99 ' other (probably CGA or MDA)
END IF
END FUNCTION